package Sgdb::Cntr::PassiveProf;

require Tk::LabFrame;
use Tk::TableMatrix;

use Sgdb::Utils qw(:DEFAULT
                    isbusy
                    bypass_busy_for_interrupter
                    info_line_lookup
                    gdb_source_map
                    gdb_func_map
                    target_symmetrix_chdir
                    target_symmetrix_list
                    );

use warnings;
use strict;
use integer;
use bytes;

my $pulling_id;
my $samples_count = 'no samples';
my $analyze_mode = 1;
my $multi_dir;
my $auto_sync = 0;
my $smpl_sec = 36;
my $sec_read = 2;
our %statdata;
my @symbols;
my $result_tbl;
my $data_filter = '';

init();

sub init { 1 }

sub new {

    my $self = shift or die 'whoami';
    my $Topf = shift or die 'no topf';
    my $topf = $Topf -> Frame() -> pack (qw/-fill both -expand 1/) ;


    my @prefF = pref 'profiler-pane-frame', qw/-relief groove -borderwidth 2 /;
    my @prefL = pref 'profiler-pane-label' ;
    my @prefB = pref 'profiler-pane-button';
    my @prefE = pref 'profiler-pane-entry' ;
    my $f;
    my $ft = $topf->Frame(-bg=>$topf->cget('-bg')
                         )->pack(-side=>'top',-anchor=>'center');
    my @bg =('-background', $ft->cget('-background'));

    $f = $ft->LabFrame(-label=>'Profiling:',@bg,-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>0,-sticky=>'ns',-padx=>5);

    balloonset <<DoC =>
Click to buffer program
counters from multiple
targets. Target emulations
must be of the same
kind(d61f,s61e..)!
DoC
    $f->Checkbutton(-variable=>\$multi_dir,
                    -text=>'Multi dir',
                   )->grid(-row=>0,-column=>1,-columnspan=>2,-sticky=>'ew');

    balloonset <<DoC =>
Start bufffering the CPU
program counters(pcs)
(emulation CPU only).
You must set the pc buffering
rate(samples/second) and
the puling delay value
(secons/read) first!
DoC
    $f->Button(@prefB,-text=>'Start',
               -command=>\&online_collect_start,
              )->grid(-row=>1,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    bypass_busy_for_interrupter
    balloonset <<DoC =>
Stop buffering CPU program counters!
DoC
    $f->Button(@prefB,-text=>'Stop',
               -command=>\&online_collect_stop,
              )->grid(-row=>2,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Sampling frequency in
samples per second!
DoC
    $f->Entry(@prefE,-textvariable=>\$smpl_sec,
              -width=>3,
             )->grid(-row=>1,-column=>1,-sticky=>'e');

    $f->Label(-text=>'samples/sec',
             )->grid(-row=>1,-column=>2,-sticky=>'w');

    balloonset <<DoC =>
Pulling delay value is
the interval(in seconds)
between consecutive reads
from the buffer.
It tells you how frequently
the number of collected samples
is updated.
Avoid setting this value to
less than 2 seconds!
DoC
    $f->Entry(@prefE,-textvariable=>\$sec_read,
              -width=>3,
             )->grid(-row=>2,-column=>1,-sticky=>'e');

    $f->Label(-text=>'readout/sec',
             )->grid(-row=>2,-column=>2,-sticky=>'w');

    $f = $ft->LabFrame(-label=>'Analyze by:',@bg,-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>1,-sticky=>'ns',-padx=>5);

    balloonset <<DoC =>
Sort the buffered CPU
program counter hits by
functions. These are functions
that contain instructions hit
upon CPU sampling.
DoC
    $f->Radiobutton(-text=>'function',
                    -value=>1,
                    -variable=>\$analyze_mode,
                    -command=>\&show_data,
                   )->grid(-row=>0,-column=>0,-sticky=>'w',-padx=>5);

    balloonset <<DoC =>
Sort the buffered CPU
program counter hits by modules.
Modules are source files that
contain instructions hit
upon CPU sampling.
DoC
    $f->Radiobutton(-text=>'module' ,
                    -value=>2,
                    -variable=>\$analyze_mode,
                    -command=>\&show_data,
                   )->grid(-row=>1,-column=>0,-sticky=>'w',-padx=>5);

    balloonset <<DoC =>
Automatically analyze
samples as they are
read.
DoC
    $f->Checkbutton(-variable=>\$auto_sync,
                    -text=>'Auto sync',
                   )->grid(-row=>3,-column=>0,-columnspan=>2,-sticky=>'ns');

    $f = $ft->LabFrame(-label=>'Samples:',@bg,-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>2,-sticky=>'ns',-padx=>5);

  balloonset <<DoC =>
The current number of
buffered CPU program
counters(pcs).
DoC
    $f->Label(@prefL,-bg=>'white',-textvariable=>\$samples_count,
             )->grid(-row=>0,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Display the buffered CPU samples
sorted by function or module
(source file).
Specify the sorting criterion
by clicking the corresponding button.
DoC
    $f->Button(@prefB,-text=>'Analyze' ,
               -command=>\&show_data,
              )->grid(-row=>1,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Clear the collected CPU
program counters from
the buffer.
DoC
    $f->Button(@prefB,-text=>'Clear' ,
               -command=>sub { %statdata =(); $samples_count = 'no samples'; show_data() },
              )->grid(-row=>2,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);


    $f = $ft->LabFrame(-label=>'File:',@bg,-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>3,-sticky=>'ns',-padx=>5);

   balloonset <<DoC =>
Load a log file containing
CPU program counter statistics.
DoC
    $f->Button(@prefB,-text=>'Load',
               -command=>\&load_from_file,
              )->grid(-row=>0,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Save the buffered CPU
program counters to a file!
In case of multiple hits per
function, address block,
or module, all addresses
in question will be logged.
DoC
    $f->Button(@prefB,-text=>'Save',
               -command=>\&save_to_file,
              )->grid(-row=>2,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Close the Profiler pane.
DoC
    $ft->Button(@prefB,-text=>'Close',
                -command=>sub{online_collect_stop(); $Topf->destroy},
               )->grid(-row=>0,-sticky=>'w',-column=>4);


    my $filter = $topf->LabEntry(-label=>'Filter',-labelPack=>[-side=>'left'],
                                 -textvariable=>\$data_filter,
                                 @prefE
                                )->pack(-fill=>'x',-expand=>0,-anchor=>'n',-side=>'top');

    my @pref_tablematrix  = pref 'profiler-pane-tablematrix';
    my $modules_data = {};

    balloonset <<DoC =>
Click on the column header
to sort table according
this column contents.
DoC
    my $mtf = $topf->Scrolled('TableMatrix',
                           @pref_tablematrix,
                           -titlerows=>1, -titlecols=>1,
                           -colstretchmode=>'unset',
                           -resizeborders=>'col',
                           -cols=>6,
                           -selectmode=>'extended',
                           -cache=>0,
                           -variable=>$modules_data
                         )->pack(-fill=>'both',-expand=>1,-anchor=>'n',-side=>'top');

    $result_tbl = $mtf->{SubWidget}->{'tablematrix'};
    $result_tbl->MouseWheelBind("Tk::TableMatrix");
    $result_tbl->tagConfigure('title', -fg=>'blue', -relief=>'sunken', -anchor=>'center');
    $result_tbl->rowHeight(0,2);
    $modules_data->{"0,1"} = "Counts";
    $modules_data->{"0,2"} = "%";
    $modules_data->{"0,3"} = ('',"Functions","Modules")[$analyze_mode];
    $modules_data->{"0,4"} = "Start\nAddress";
    $modules_data->{"0,5"} = "End\nAddress",

    $result_tbl->{'sortcol'} = 1;
    $result_tbl->{'sortdir'} = 1;

	$result_tbl->bind('<ButtonRelease-1>',\&click_result_tbl);
	$result_tbl->bind('<Double-1>',\&double_click_result_tbl);
    $filter->bind('<KeyRelease>',\&show_data);

    $result_tbl->colWidth(0=>5, 1=>8, 2=>8, 4=>8, 5=>8);
    $result_tbl->tagConfigure('right', -anchor=>'e');
    $result_tbl->tagCol('right',1,2,4,5);

    $topf;
}

sub load_from_file {

    my $file = shift || find_file(0,
                                    'Load PC Samples From ..' ,
                                    pref('last-pc-samples-filename'),
                                 ) or return;

    return telthemloud "'$file' no such file " unless     -e  $file;
    return telthemloud "'$file' is a directory" if        -d  $file;
    return telthemloud "'$file' not text file" unless     -T  $file;

    pref_set 'last-pc-samples-filename', $file;

    %statdata =();
    open F, $file or return telthemloud "can't open $file: $!";
    while(<F>) {
        next if /^\=/;
        next if /^\#/;
        my ($addr,$count) = split /\W+/;
        $statdata{hex $addr} = $count;
    }
    $samples_count = count_total();
    close F;
    if ($auto_sync) {
        show_data()
    }
}

sub save_to_file {

    my $file = find_file(1,
                           'Save Passive Profiler Log',
                           pref 'last-pc-samples-save-filename'
                        ) or return;

    open SLOG, ">$file" or return telthemloud "can't open $file: $!";

    my ($targ) = gdb_exec_quiet("i symmetrix-targets") =~ /\"(\S*)\" *\(current\)/m;
    print SLOG
        "# file : " , gdb_cached('file'),
      "\n# date : " , scalar(localtime),
      "\n# fixes: " , gdb_cached('syren-v') =~ /\"(.*)\"/,
      "\n# symm : " , $targ || '??' ,
      "\n";

    my @addresses = sort {$a <=> $b} keys(%statdata);
    for my $addr (@addresses) {
        printf SLOG "0x%x %d\n", $addr,$statdata{$addr};
    }
    close SLOG;
    pref_set 'last-pc-samples-save-filename', $file;
}

sub init_symbols {
    my $mode = shift;

    if($mode == 3) {
        return 1;
    }

    gdb_cached 'is-alive' or return telthemloud 'No Active Debugger';
    return 1 if(gdb_cached('passive-analyze-mode') || '') eq $mode;
    my $symfile = gdb_cached 'file' or return telthemloud 'No Symbol File';
    @symbols =();

    if($mode == 1) {
        busy;
        my $map = gdb_func_map();
        @symbols = @{$map};
    } elsif ($mode == 2) {
        busy;
        my $map = gdb_source_map();
        while(my ($source,$v) = each(%{$map})) {
            my ($addr,$len,$ver,$tag,$status,$alias) = @$v;
            push(@symbols,[$addr,$len,$source]) if $addr && $len;
        }
    } else {
        telthemloud 'Unsupported mode: <$mode>';
        return;
    }

    @symbols = sort {$a->[0] <=> $b->[0]} @symbols;
    for my $i(0..scalar(@symbols)-2) {
        my ($addr,$len,$source) = @{$symbols[$i]};
        next if $len;
        my ($addr2,$len2,$source2) = @{$symbols[$i+1]};
        $symbols[$i]->[1] = $addr2-$addr;
    }
    gdb_cached('passive-analyze-mode', $mode);
    unbusy;
    return 1;
}

sub count_total {
    my $total_counts = 0;
    map { $total_counts += $statdata{$_} } keys(%statdata);
    return $total_counts;
}

sub analyze_statdata {
    my $mode = shift;
    my $sort_col = shift;
    my $sort_dir = shift;

    init_symbols($mode);
    my $total_counts = count_total();

    my @res;
    my %resmap;

    my @addresses = sort {$a <=> $b} keys(%statdata);
    for my $psym (@symbols) {
        my ($start,$len,$name) = @$psym;
        my $stop = $start+$len-1;
        my $count = 0;
        while (@addresses) {
            my $addr = shift @addresses;
            if ($addr < $start) {
                printf "ERROR: 0x%x < 0x%x\n",$addr,$start;
                next;
            } elsif ($addr <= $stop) {
                $count += $statdata{$addr};
                next;
            }
            unshift @addresses,$addr;
            last;
        }
        next unless $count;
        my $pcount = 0.0;
        if ($total_counts) {
            no integer;
            $pcount = 100.0*$count/$total_counts;
        }
        my @map =(0,$count,$pcount,$name,$start,$stop);
        my $key = $map[$sort_col];
        $map[0] = $key;
        push(@res,\@map);
        last unless scalar(@addresses);
    }

    if($sort_col == 3) {
        @res = sort {$a->[0] cmp $b->[0]} @res;
    } else {
        @res = sort {$a->[0] <=> $b->[0]} @res;
    }
    if($sort_dir == 1) {
        @res = reverse(@res);
    }
    return @res;
}

sub show_data {

    my @rows =  analyze_statdata($analyze_mode,$result_tbl->{'sortcol'},$result_tbl->{'sortdir'});
    $result_tbl->configure(-state=>'normal');
    my $tdata = $result_tbl->cget("-variable");
    my $rows = $result_tbl->cget("rows");
    my $cols = $result_tbl->cget("cols");
    delete @{$tdata}{map { my $col=$_; map {"$col,$_"}(0..$cols-1)}(1..$rows-1)};
    $tdata->{"0,3"} = ('',"Functions","Modules")[$analyze_mode];
    my $row = 1;
    for my $arow (@rows) {
        my ($x,$counts,$pcounts,$name,$start,$stop) = @{$arow};
        if($data_filter ne ''){
            if (index(sprintf("%d %15.4g %s %x %x",$counts,$pcounts,$name,$start,$stop),$data_filter)<0) {
                next;
            }
        }
        $tdata->{"$row,0"} = $row;
        $tdata->{"$row,1"} = $counts;
        $tdata->{"$row,2"} = sprintf("%15.4g",$pcounts);
        $tdata->{"$row,3"} = $name;
        $tdata->{"$row,4"} = sprintf("%x",$start);
        $tdata->{"$row,5"} = sprintf("%x",$stop);
        $row += 1;
    }
    $result_tbl->configure(-variable=>$tdata,-rows=>$row+1);
    $result_tbl->configure(-state=>'disabled');
}

sub double_click_result_tbl {
    my $tbl = shift;
    my $row = $tbl->index('active','row');
    return unless $row > 0;
    my $tdata = $tbl->cget("-variable");
    return unless $tdata;
    my $addr = $tdata->{"$row,4"};
    return unless $addr;
    gdb_exec_lock("info line *0x$addr");
}

sub click_result_tbl {
    my $tbl = shift;

    my $row = $tbl->index('active','row');
    my $col = $tbl->index('active','col');
    return unless($col > 0) &&($row <= 0);
    my $old_sortcol = $tbl->{'sortcol'};
    my $sortdir = $tbl->{'sortdir'};
    if($tbl->{'sortcol'} == $col) {
        $tbl->{'sortdir'} =($tbl->{'sortdir'}+1) % 2;
    }
    $tbl->{'sortcol'} = $col;
    show_data();
}

sub online_collect {

    return if isbusy;
    busy;
    if($multi_dir) {
#        my @targets = gdb_exec_quiet("info symmetrix-targets") =~ /\"(.*)\"/g;
        my @targets = target_symmetrix_list() ;
        for my $dir(@targets) {
#             gdb_exec_quiet("target symmetrix $dir");
            target_symmetrix_chdir($dir, 1);
            my $buf = gdb_exec_quiet("symm-profiler PG");
            if($buf =~ /^OK([\da-fA-F\s]*)$/) {
                map {$statdata{$_}++} map { hex "$_" } split ' ',$1;
            } else {
                telthemloud "Bad data from symm: <$buf>\n";
            }
        }
    }
    else {
        my $buf = gdb_exec_quiet("symm-profiler PG");
        if($buf =~ /^OK([\da-fA-F\s]*)$/) {
            map {$statdata{$_}++} map { hex "$_" } split ' ',$1;
        } else {
            telthemloud "Bad data from symm: <$buf>\n";
        }
    }
    unbusy;

    $samples_count = count_total();
    if ($auto_sync) {
        show_data();
    }
    $mainwindow -> idletasks() ;
}

sub online_collect_start {

    gdb_cached 'is-alive' or return telthemloud 'No Active Debugger';
    online_collect_stop();    # just in case
    my $sr = $sec_read * 1000;
    return telthemloud "ambiguous pulling delay value" unless $sr;
    my $ss = sprintf "%x", $smpl_sec;
    return telthemloud "ambiguous samples per seconds value" unless $ss;

    my $res;
    if($multi_dir) {
        busy;
#        my @targets = gdb_exec_quiet("info symmetrix-targets") =~ /\"(.*)\"/g;
        my @targets = target_symmetrix_list() ;
        for my $dir(@targets) {
#             gdb_exec("target symmetrix $dir");
            target_symmetrix_chdir($dir, 1) ;
            $res .= gdb_exec("symm-profiler PC$ss");
        }
        unbusy;
    }
    else {
        $res = gdb_exec_lock("symm-profiler PC$ss");
    }
    return unless $res && $res =~ /ok/i;

    $pulling_id = $mainwindow->repeat($sr , \&online_collect);
}

sub online_collect_stop {

    if($pulling_id) {
        $pulling_id->cancel($pulling_id);
        $pulling_id = 0;
    }
}
